home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 11 / FM Towns Free Software Collection 11.iso / t_os / tool / hk2 / bas / hk2.bas next >
Encoding:
BASIC Source File  |  1995-07-09  |  47.2 KB  |  1,175 lines
  1. 10 '------------------------------------------------------------------
  2. 20 '  HK2.BAS  Copyrigit(C) T.Komura       / 家計簿システムHK    /
  3. 30 '                                       / Version 2.0         /
  4. 31 '  Version 1.0  1993.01.01 公開ﾊﾞｰｼﾞｮﾝ  / MAINプログラム      /
  5. 32 '          1.1  1993.07.26            
  6. 33 '          1.1a 1993.08.22 新規データﾌｧｲﾙ作成拒否時のjump先修正
  7. 34 '          1.3  1994.02.01 hk v1.3対応 ｶﾚﾝﾀﾞｰ機能追加
  8. 35 '          1.4  1994.06.20 hk v1.4対応 
  9. 36 '          1.4a 1994.07.04 音声ファイル名バグ修正
  10. 37 '          1.4e 1994.07.10 helpファイル表示機能追加
  11. 38 '     V2.0 L10a 1995.05.22 Version2へレベルアップ
  12. 39 '     V2.0 L10b 1995.06.28 HK2.CFGにバージョン情報を持たせる｡　
  13. 40 '     V2.0 L10c 1995.07.03 新規家計簿ファイル未作成時｢設定｣起動機能追加　
  14. 41 '                          新規家計簿ファイル作成時処理状況を表示
  15. 100 '------------------------------------------------------------------
  16. 140 CLEAR ,,,,1024,300*1024
  17. 150 DIM CFI$(15)
  18. 170 GOSUB *CONFIGファイルチェック
  19. 190 '
  20. 200 *初期設定:'--------------------------------------------------------
  21. 210 CMD$="CD "+PRGDRV$:SHELL CMD$
  22. 220 CONSOLE 0,24,0:MOUSE 0
  23. 221 MOUSE 0
  24. 230 DIM MSGD%(28000):' 音声メッセージ配列定義 プログラム先頭で定義
  25. 240 LOAD@ FMBDRV$+"\FMP.FMB"
  26. 250 PLAY "@30T150V6":DATX$=DATE$
  27. 255 'ウインドウ関係座標配列
  28. 256 G=7:B=50
  29. 260 DIM B_X1(G,B),B_X2(G,B),B_Y1(G,B),B_Y2(G,B),BST(G,B)
  30. 265 DIM W_X1(G),W_X2(G),W_Y1(G),W_Y2(G)
  31. 266 DIM W_XA(G),W_XB(G),W_YA(G),W_YB(G)
  32. 267 DIM MD_SB#(10465),MD_SW#(10465):'max : HELP window
  33. 268 'デ－タ配列
  34. 270 DIM DYN$(16),DRM$(16),DYN#(16),EVDT$(12,32)
  35. 274 DIM DYNX#(15)                             :'累計計算用一時記憶
  36. 275 DIM DYT$(15),DYM$(15),DYA$(15),DYR$(15)   :'累計データ
  37. 276 DIM DYT#(15),DYM#(15),DYA#(15),DYR#(15)   :'累計データ
  38. 280 DIM WRD$(15,128),WLN(15,128),WRDM(128)    :'辞書データ
  39. 290 DIM COX$(10,5)                            :'定額データ
  40. 295 DIM DOC$(2000)                            :'HELPデータ
  41. 300 INTERVAL 1                  :'プログラム先頭
  42. 310 ON INTERVAL GOSUB *時計表示 :'プログラム先頭 
  43. 320 GOSUB *ボタン座標読み取り
  44. 325 GOSUB *MCREAD:GOSUB *DCLOCKREAD
  45. 330 'CLS:COLOR 7:PRINT int((int(((155-14+1)+7)/8)*(415-131+1)*4+8-1)/8)
  46. 360 DIM LMB#(900),ABOUTD#(2071),HLPL#(397),HLPC#(8449)
  47. 370 ON ERROR GOTO *ERROR
  48. 380 '
  49. 426 HKEND=10 :'終了ボタン番号
  50. 440 DOCF$="\HK2main.HLP"
  51. 500 '------------------------------------------------------------------
  52. 990 '////////////////////////////////////////////////////////////////////
  53. 1000 *メインルーチン:'･･･････････････････････････････････････････････････
  54. 1005 GOSUB *SEFFECT1
  55. 1010 MESN=21:GOSUB *SNDMSG
  56. 1020 GOSUB *本日の日付
  57. 1035 MCN=1:GOSUB *MCDSET:MOUSE 1,320,64,1
  58. 1040 GOSUB *HLIDXファイルチェック
  59. 1100 *メイン選択 '////////////////////////////////////////////////////////
  60. 1110 MCN=1:GOSUB *MCDSET'
  61. 1120 MESN=1:GOSUB *MESDSP
  62. 1130 G=1:GOSUB *MCSELECT
  63. 1145 IF SWNO<0 THEN SWNO=10
  64. 1148 '            hk2  記入 検索 分析 cld  設定 日付 時計 help end
  65. 1150 ON SWNO GOTO *S01,*SPG,*SPG,*SPG,*SPG,*SPG,*S07,*S08,*S09,*S10
  66. 1160 GOTO 1100
  67. 2000 *S01
  68. 2020  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  69. 2022  MESN=10:GOSUB *MESDSP
  70. 2025  GOSUB *ABOUT表示
  71. 2030  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  72. 2040  GOTO *メイン選択
  73. 2050 '
  74. 2100 *S09
  75. 2120  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  76. 2122  MESN=9:GOSUB *MESDSP
  77. 2125  GOSUB *HKHELP
  78. 2130  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  79. 2140  GOTO *メイン選択
  80. 2150 '
  81. 2200 *S08
  82. 2220  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  83. 2222  MESN=11:GOSUB *MESDSP
  84. 2225  GOSUB *DGCLOCK
  85. 2230  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  86. 2240  GOTO *メイン選択
  87. 2250 '
  88. 2300 *S07
  89. 2320  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  90. 2322  'MESN=9:GOSUB *MESDSP
  91. 2330  G=1:B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  92. 2340  GOTO *メイン選択
  93. 2350 '
  94. 3000 *SPG:'-----------------------------------------------------------
  95. 3010  G=1:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  96. 3015  MESN=4+(B-2):GOSUB *MESDSP
  97. 3020  MESN=24:GOSUB *SNDMSG
  98. 3030  MCN=2:GOSUB *MCDSET:INTERVAL OFF:GOSUB *SEFFECT2 ' :STOP
  99. 3040  ON B-1 GOTO *PRG01,*PRG02,*PRG03,*PRG04,*PRG05
  100. 3100 *PRG01:RUN"HK2in.bas"
  101. 3110 *PRG02:RUN"HK2src.bas"
  102. 3120 *PRG03:RUN"HK2ANL.bas"
  103. 3130 *PRG04:RUN"HK2CLD.bas"
  104. 3140 *PRG05:RUN"HK2Cfg.bas"
  105. 8940 '
  106. 9000 *S10:'終了････････････････････････････････････････････････････････
  107. 9020 G=1:B=HKEND:BST(G,B)=1:GOSUB *BTN_ONOFF
  108. 9030 MESN=2:GOSUB *MESDSP
  109. 9040 CMES$="家計簿システム ＨＫ２ を終了します｡":GOSUB *確認
  110. 9050 IF CAUNO=1 THEN 9110
  111. 9060 G=1:B=HKEND:BST(G,B)=0:GOSUB *BTN_ONOFF
  112. 9065 IF IR=0 THEN GOTO 1040
  113. 9070 GOTO *メイン選択
  114. 9080 *S10_01'
  115. 9110 MESN=3:GOSUB *MESDSP:MESN=6:GOSUB *SNDMSG
  116. 9120 FOR II=1 TO 5000:NEXT II:INTERVAL OFF
  117. 9130 MOUSE 5:GOSUB *FADEOUT
  118. 9140 'SHELL "cd \"
  119. 9150 SYSTEM
  120. 9160 '
  121. 9200 *S10_02:'家計簿ファイルなし    ･･･････････････････････････････････
  122. 9230 MESN=15:GOSUB *MESDSP
  123. 9240 CMES$="[設定]で家計簿データファイルを設定":GOSUB *確認
  124. 9250 IF CAUNO=2 THEN *S10
  125. 9265 SWNO=6: GOTO *SPG
  126. 9360 '
  127. 9900 '-------------------------------------------------------------------
  128. 9910 '    ＧＥＮＥＲＡＬ　ＳＵＢ　ＲＯＵＴＩＮＥ
  129. 9920 '-------------------------------------------------------------------
  130. 10000 *CHR1IN:'////////// 1文字入力
  131. 10010  A$=INKEY$:IF A$="" THEN 10010
  132. 10020  A=INSTR(C$,A$)
  133. 10030  IF A=0 THEN MESN=13:GOSUB *SNDMSG:GOTO 10010
  134. 10040  RETURN
  135. 10050 '
  136. 10060 '
  137. 10070 *MESDSP:'////////// メッセージ表示
  138. 10080  RESTORE *MESDAT
  139. 10090  FOR IM=1 TO MESN:READ XM,YM,CM,CB,BM,MES$:NEXT IM
  140. 10105  LINE(0,463)-(639,479),PSET,0,BF
  141. 10115  SYMBOL(0,465),MES$,.75!,.75!,CM
  142. 10120  'IF BM=1 THEN PLAY "L4O4A"
  143. 10130  RETURN
  144. 10140 '
  145. 10200 *MESDAT:'////////// メッセージデータ
  146. 10205 '    XM, YN, CM, CB, BM
  147. 10210 DATA  2, 23,  7,  0,  1 :'--- 01
  148. 10215 DATA "家計簿システム ＨＫ２ ●適当なボタンを選んで押してください｡
  149. 10220 DATA  2, 23,  6,  0,  0 :'--- 02
  150. 10225 DATA "家計簿システム ＨＫ２ を終了します｡ よろしいですか?   終了-[OK] 終わらない-[NG]"
  151. 10230 DATA  2, 23,  5,  0,  0 :'--- 03
  152. 10235 DATA "家計簿システム ＨＫ２をご利用いただき､ありがとうございました｡"
  153. 10240 DATA  2, 23,  4,  0,  0 :'--- 04
  154. 10245 DATA "★ [記入]モードに入ります｡ しばらくお待ちください ･････"
  155. 10250 DATA  2, 23,  4,  0,  1 :'--- 05
  156. 10255 DATA "★ [検索]モードに入ります｡ しばらくお待ちください ･････"
  157. 10260 DATA  2, 23,  4,  0,  1 :'--- 06
  158. 10265 DATA "★ [分析]モードに入ります｡ しばらくお待ちください ･････"
  159. 10270 DATA  2, 23,  4,  0,  0 :'--- 07
  160. 10275 DATA "★ [カレンダー]モードに入ります｡ しばらくお待ちください ･････"
  161. 10280 DATA  2, 23,  4,  0,  0 :'--- 08
  162. 10285 DATA "★ [設定]モードに入ります｡ しばらくお待ちください ･････"
  163. 10290 DATA  2, 23,  5,  0,  1 :'--- 09
  164. 10295 DATA "HKHELP★メインメニューの説明を表示しています｡  頁移動-[ﾋ][ﾌ] 行移動-[▲][▼] 終了-[■]" 
  165. 10300 DATA  2, 23,  5,  0,  0 :'--- 10
  166. 10305 DATA "毎度ご利用いただきまして､ありがとうございます... Comtan."
  167. 10310 DATA  2, 23,  4,  0,  0 :'--- 11
  168. 10315 DATA "ただいまの時刻です..."
  169. 10320 DATA  2, 23,  6,  0,  0 :'--- 12
  170. 10325 DATA "家計簿ファイルがありません｡ 家計簿ファイルを新規に作成しますか [OK]-作成 [NG]-作成しない"
  171. 10330 DATA  2, 23,  7,  0,  1 :'--- 13
  172. 10335 DATA "家計簿ファイルの作成開始年月を入力してください｡"
  173. 10340 DATA  2, 23,  4,  0,  1 :'--- 14
  174. 10345 DATA "★新規家計簿ファイルを作成中です｡"
  175. 10350 DATA  2, 23,  6,  0,  1 :'--- 15
  176. 10355 DATA "[設定]モードへ移行し､データファイルの設定をしてください｡  [OK]-設定モードへ [NG]-プログラムを終了"
  177. 10600 *SEFFECT1'////////////////////////////////////////////////////////
  178. 10605  SCREEN 1,1,2,1:PALETTE 9,[0,0,0]:LINE(0,0)-(639,479),PSET,1,BF
  179. 10610  SCREEN 1,0,2,1:GOSUB *表紙表示
  180. 10612  SCREEN 1,1,3,1:
  181. 10620  FOR II=0 TO 240 STEP 2:PALETTE 9,[II,II,II]
  182. 10621 '   LINE(320-II,240-II*3/4)-(320+II,240+II*3/4),PSET,0,B
  183. 10622     LINE(0,240-II)-(639,240+II),PSET,0,BF
  184. 10623  NEXT II
  185. 10630  SCREEN 1,0,1,0
  186. 10635  PUT@A(X1A,Y1A)-(X1A+XPA,Y1A+YPA),ABOUTD#
  187. 10640  SCREEN 0:INTERVAL ON
  188. 10645  RETURN
  189. 10650 '
  190. 10700 *SEFFECT2'////////////////////////////////////////////////////////
  191. 10712  SCREEN 1,1,3,1:
  192. 10720  FOR II=240 TO 0 STEP -1:PALETTE 9,[II,II,II]
  193. 10721     LINE(0,240+II)-(639,240-II),PSET,1,B
  194. 10723  NEXT II
  195. 10730  MESN=4+(B-2):GOSUB *MESDSP
  196. 10740  RETURN
  197. 10990 '
  198. 11000 *SNDMSG:'  SAVE "SNDMSG.SUB",A
  199. 11005  IF SNDMF=0 THEN RETURN
  200. 11010  '･････････････････  サウンドメッセージ実行サブルーチン  1989.02.04
  201. 11020  '                   入力=MESN (メッセージNo.)
  202. 11030  '
  203. 11070  IF MESN>36 THEN *RETURN_SNDMSG :'END
  204. 11080  RESTORE *MSGNAM
  205. 11090  FOR IMSG=1 TO MESN
  206. 11100    READ MSGD$
  207. 11110  NEXT IMSG
  208. 11120  MSGFN$=SNDDRV$+"\"+MSGD$+"_F.SND"
  209. 11130  LOAD@ MSGFN$,MSGD%
  210. 11140  PCMPLAY MSGD%:WAIT SWAIT\1+1
  211. 11150 *RETURN_SNDMSG :RETURN
  212. 11160 *MSGNAM :'////////// .SND File Name Data
  213. 11170 DATA "OHA1"   :'  1 おはよう
  214. 11180 DATA "KONN"   :'  2 こんにちわ
  215. 11190 DATA "KONBAN" :'  3 こんばんわ
  216. 11200 DATA "goyuku" :'  4 ごゆっくり
  217. 11210 DATA "GOKRO2" :'  5 ごくろうさま
  218. 11220 DATA "OTUKA"  :'  6 お疲れさま
  219. 11230 DATA "DOUZO"  :'  7 おまたせ
  220. 11240 DATA "ARIGA2" :'  8 ありがとう
  221. 11250 DATA "RUNRUN" :'  9 るんるん
  222. 11260 DATA "DAMEDE" :' 10 だめでしょう
  223. 11270 DATA "IIDE1"  :' 11 いいですか
  224. 11280 DATA "NANISI" :' 12 なにしてるの
  225. 11290 DATA "DAMEDA" :' 13 だめだめ
  226. 11300 DATA "OWARI"  :' 14 終わりました
  227. 11310 DATA "SIBA"   :' 15 しばらくお待ち下さい
  228. 11320 DATA "YOROSI" :' 16 よろしいですか
  229. 11330 DATA "TYANTO" :' 17 ちゃんとしなさい
  230. 11340 DATA "ERANDE" :' 18 選んでください
  231. 11350 DATA "KAKNIN" :' 19 確認して下さい
  232. 11360 DATA "NYURYO" :' 20 入力してください
  233. 11370 DATA "IRA"    :' 21 いらっしゃいませ 
  234. 11380 DATA "OYASUM" :' 22 おやすみ
  235. 11390 DATA "ARIGA3" :' 23 ありがとうございました
  236. 11400 DATA "TYOTO"  :' 24 ちょっと待って
  237. 11410 DATA "DAMEYO" :' 25 駄目よ
  238. 11420 DATA "YAMETE" :' 26 やめて
  239. 11430 DATA "TIGAU"  :' 27 ちがうよ
  240. 11440 DATA "PINPON" :' 28 ぴんぽーん
  241. 11450 DATA "BUU"    :' 29 ぶー
  242. 11460 DATA "MOUII"  :' 30 もういいよう  
  243. 11470 DATA "DEKITA" :' 31 できたよー
  244. 11480 DATA "IIDE2"  :' 32 いいですか（２）
  245. 11490 DATA "YOSI"   :' 33 よしなさい
  246. 11500 DATA "OYOSI"  :' 34 およしなさい
  247. 11510 DATA "YAMENA" :' 35 やめなさい
  248. 11520 DATA "GOMEN"  :' 36 ごめん
  249. 11530 '                                    
  250. 12000 '////////// 年月日入力 & 曜日表示
  251. 12010 '                    
  252. 12045 *週検索
  253. 12050  DATA "SUN",2,"MON",7,"TUE",7,"WED",7,"THU",7,"FRI",7,"SAT",5
  254. 12060  GOSUB *WEEKN:RESTORE 12050:FOR IW=0 TO WK:READ WKM$,CW:NEXT IW
  255. 12080  RETURN
  256. 12090 '
  257. 12450 *WEEKN :'////////// 週NO.検索    'v1.3 bugfix 93.12.27
  258. 12460  U=0    :'････････････････････････ Input; YR MN   Output; WK DN
  259. 12470  IF YR/4-INT(YR/4)=0 THEN U=1
  260. 12480  DATA 0,31,28,31,30,31,30,31,31,30,31,30,31
  261. 12490  DATA 0,31,29,31,30,31,30,31,31,30,31,30,31
  262. 12500  IF U=0 THEN RESTORE 12480 ELSE RESTORE 12490
  263. 12505 'IF MN=1 THEN MDN=0:MNDN=31:GOTO 12520
  264. 12510  MDN=0:FOR IWEKN=1 TO MN:READ DN:MDN=MDN+DN:NEXT IWEKN:'1日までの日数
  265. 12515  READ MNDN                                              :'当月の日数
  266. 12516  IF DY>MNDN THEN DY=MNDN                                :'V1.3!
  267. 12520  YDN#=MDN+YR*365+INT((YR+3)/4)+5+DY-1
  268. 12530  WK=(YDN#/7-INT(YDN#/7))*7
  269. 12540  RETURN
  270. 12550 '
  271. 12600 *年月日変更:                     'v1.3 bugfix 93.12.27
  272. 12601  GOSUB *WEEKN
  273. 12602  DY=DY+DDEF
  274. 12604  IF DY>MNDN THEN DY=1     :MDEF=+1
  275. 12606  IF DY<1    THEN DY=31    :MDEF=-1
  276. 12610  MN=MN+MDEF
  277. 12620  IF MN>12   THEN MN=MN-12 :YDEF=+1
  278. 12630  IF MN<1    THEN MN=12+MN :YDEF=-1
  279. 12640  YR=YR+YDEF
  280. 12650  IF YR<0    THEN YR=10000+YR
  281. 12660  IF YR>9999 THEN YR=YR-10000
  282. 12665  GOSUB *WEEKN
  283. 12668  DY$=RIGHT$(STR$(100+DY),2)
  284. 12670  MN$=RIGHT$(STR$(100+MN),2)
  285. 12680  YR$=RIGHT$(STR$(10000+YR),4)
  286. 12690  RETURN
  287. 12695 '
  288. 12700 *本日の日付
  289. 12705  DEF FONT "システム   12ﾄﾞｯﾄ"
  290. 12710  TY$=LEFT$(DATE$,2) :TY=VAL(TY$)
  291. 12720  IF TY<90 THEN TY=TY+2000 ELSE TY=TY+1900
  292. 12730  TY$=RIGHT$(STR$(TY),4)
  293. 12740  TM$=MID$(DATE$,4,2):TM=VAL(TM$)
  294. 12750  TD$=RIGHT$(DATE$,2):TD=VAL(TD$)
  295. 12760  YR=TY:MN=TM:DY=TD:GOSUB *週検索:IF CW=0 THEN CW=7
  296. 12770  TYMD$=TY$+"."+TM$+"."+TD$
  297. 12780  LINE(475,5)-(560,17),PSET,0,BF
  298. 12790  SYMBOL(476,6),TYMD$,.75!,.75!,7
  299. 12800  SYMBOL(542,6),WKM$,.75!,.75!,CW
  300. 12810  RETURN
  301. 12820 '
  302. 13000 '////////////////////////////////////////////////////////////////////
  303. 13001 ' LKEYIN   v1.1a 全角文字移動改良                1993.02.12 T.Komura
  304. 13002 '--------- v1.2  挿入モードの変更他全面bugFIX    1993.08.04 T.Komura
  305. 13003 '          v2.0  グラフィックモード12dot用に改造 1994.07.30 T.Komura
  306. 13004 '          v2.1  マルチカラムに改造              1994.09.02 T.Komura
  307. 13005 '          v2.2  編集文字を初期表示するように改造1995.04.29 T.Komura
  308. 13006 '
  309. 13010 *LKEYIN  :'･･･････････ 1 行全角文字入力サブルーチン
  310. 13020 '   入力 = LX,LY : 表示開始座標      LG    : 行数     
  311. 13030 '          L$(ii): 初期文字列        LP    : 行ピッチ       
  312. 13040 '          LC    : 表示文字色        lb    : 非編集行文字色
  313. 13050 '          LL    : 最大文字数        cbc    : 背景色
  314. 13060 '          LINS  : 挿入ﾓｰﾄﾞ=1  出力=L$(ii) : 入力後の文字列
  315. 13070 '         
  316. 13080  LCSRCL=6:LLINCL=4
  317. 13090  DEF FONT "システム   12ﾄﾞｯﾄ"
  318. 13100 '           CR   MR   ML  INS  DEL   BS  CAN
  319. 13120 ' LMSX=MOUSE(0):LMSY=MOUSE(1):MOUSE 5       :'v1.1a
  320. 13130  CC$=CHR$(&H0D,&H1E,&H1F,&H1C,&H1D,&H12,&H7F,&H08,&H18)
  321. 13140 ' LMG$=SPACE$(LL):LMGD$=SPACE$(LL)          :'2.1
  322. 13150  LA$=INKEY$:IF LA$<>"" THEN 13150
  323. 13160  IF LINS=1 THEN CWDT=1 ELSE CWDT=5
  324. 13170  LCSR=0:LGC=1                               :'v2.1
  325. 13180  LINE(LX,LY)-(LX+LL*6+1,LY+11),PSET,%CBC,BF :'v2.2
  326. 13185  GET@A (LX,LY)-(LX+LL*6+1,LY+13),LMB#       :'v2.0
  327. 13190  FOR LGII=1 TO LG:LXX=LX:LYY=LY+(LGII-1)*LP :'v2.1････ 初期文字列表示
  328. 13200   PUT@A (LX,LYY)-(LX+LL*6+1,LYY+13),LMB#    :'v2.1
  329. 13210   SYMBOL(LXX,LYY),L$(LGII),.75!,.75!,LB     :'v2.1
  330. 13220  NEXT LGII                                  :'v2.1
  331. 13230 *SETLG             :'----------行セット     :'v2.1
  332. 13240  LYY=LY+(LGC-1)*LP :LM$=L$(LGC)             :'v2.1
  333. 13250   SYMBOL(LXX,LYY),L$(LGC),.75!,.75!,LC      :'v2.1
  334. 13260  LINE(LX,LYY+12)-(LX+(LL*6),LYY+12),XOR,LLINCL,BF :'v2.1
  335. 13270  LCSRX=LCSR:GOSUB *LCSRDX
  336. 13280  LMX$=LEFT$(LM$+SPACE$(LL),LL)
  337. 13290  GOSUB *LMREAD
  338. 13300  IF LMGB$="1" THEN GOSUB *LCSRDEC
  339. 13310 *IN1C:'                                  ･･････････ 1 文字入力
  340. 13320  LA$=INKEY$:IF LA$="" THEN 13320
  341. 13330  ALA=ASC(LA$):CLA=INSTR(CC$,LA$)
  342. 13340  IF CLA=0 THEN 13360
  343. 13350  ON CLA GOTO *CR,*MU,*MD,*MR,*ML,*INS,*DEL,*BS,*CAN
  344. 13360  IF KANF=1 THEN *KANJI
  345. 13370  IF ALA<&H20 THEN BEEP:GOTO *IN1C
  346. 13380  IF ALA>=&H20 AND ALA<&H80 THEN *ANK
  347. 13390  IF ALA>=&HA0 AND ALA<&HE0 THEN *ANK
  348. 13400  GOTO *KANJI
  349. 13410 *ANK :'                                  ･･････････ ANK 文字入力
  350. 13420  IF LINS=1 THEN 13440
  351. 13430  MID$(LMX$,LCSR+1,1)=LA$:GOTO 13450
  352. 13440  LMX$=LEFT$(LMX$,LCSR)+LA$+RIGHT$(LMX$,LL-LCSR)
  353. 13450  GOSUB *LCSRINC
  354. 13460  GOSUB *LMREAD1:GOSUB *LMXDSP
  355. 13470  GOTO *IN1C
  356. 13480 *KANJI :'                                ･･････････ 漢字文字入力
  357. 13490  ON KANF+1 GOTO 13500,13530
  358. 13500  KANF=1:KANW$="":KANW$=LA$
  359. 13510    IF LCSR+1>=LL THEN KANF=0:BEEP
  360. 13520    GOSUB *LCSRD:GOTO *IN1C
  361. 13530  KANF=0:KANW$=KANW$+LA$
  362. 13540    IF LINS=1 THEN 13560
  363. 13550    MID$(LMX$,LCSR+1,2)=KANW$:GOTO 13570
  364. 13560    LMX$=LEFT$(LMX$,LCSR)+KANW$+RIGHT$(LMX$,LL-LCSR)
  365. 13570    GOSUB *LCSR2INC
  366. 13580    GOSUB *LMREAD1:GOSUB *LMXDSP
  367. 13590  GOTO *IN1C
  368. 13600 *CR :GOSUB *LMREAD:GOSUB *LCSRDX         '////////// End
  369. 13610   LINE(LX,LYY+12)-(LX+(LL*6),LYY+12),XOR,LLINCL,BF     :'v2.0 :'v2.1
  370. 13620 ' MOUSE 0: MOUSE 1,LMSX,LMSY,1:MCN=1:GOSUB *MCDSET     :'v1.1a
  371. 13630 RETURN:'----------------------------------------------------------
  372. 13640 *MU :GOSUB *LMREAD2                      '////////// up   :v2.1
  373. 13645 *MU2:GOSUB *LMBDSP:LGC=LGC-1:IF LGC<1 THEN LGC=1
  374. 13655      GOTO *SETLG
  375. 13660 *MD :GOSUB *LMREAD2                      '////////// down :v2.1
  376. 13665 *MD2:GOSUB *LMBDSP:LGC=LGC+1:IF LGC>LG THEN LGC=LG
  377. 13675      GOTO *SETLG
  378. 13680 *MR :GOSUB *LMREAD2                      '////////// Right
  379. 13685      IF LMGF$="1" THEN GOSUB *LCSR2INC:GOTO *MUD    :'v2.1
  380. 13690                        GOSUB *LCSRINC :GOTO *MUD    :'v2.1
  381. 13695 *ML :GOSUB *LMREAD2                      '////////// Left
  382. 13700      IF LMGB$="2" THEN GOSUB *LCSR2DEC:GOTO *MUD    :'v2.1
  383. 13705                        GOSUB *LCSRDEC :GOTO *MUD    :'v2.1
  384. 13710 *MUD:IF LCSC=0  THEN GOTO *IN1C          '////////// line chg.ctrl:'v2.1
  385. 13715      IF LCSC=+1 THEN GOSUB *LMREAD2:LCSR=0 :GOTO *MD2
  386. 13720      IF LCSC=-1 THEN GOSUB *LMREAD2:LCSR=LL:GOTO *MU2
  387. 13725 *INS:GOSUB *LCSRDX:LINS=1-LINS           '////////// Insert
  388. 13730      IF LINS=1 THEN CWDT=1 ELSE CWDT=5
  389. 13735      GOSUB *LCSRDX                    :GOTO *IN1C
  390. 13740 *DEL:GOSUB *LMREAD:LMX$=LEFT$(LMG$,LCSR) '////////// Delete
  391. 13745      IF LMGF$="1" THEN LDEF=2 ELSE LDEF=1
  392. 13750      LMX$=LMX$+MID$(LMG$,LCSR+LDEF+1,LL-LCSR-LDEF)+"  "
  393. 13755      GOSUB *LMREAD:GOSUB *LMXDSP      :GOTO *IN1C
  394. 13760 *BS :GOSUB *LMREAD                       '////////// BackSpace
  395. 13765      IF LCSR=0 THEN GOTO *IN1C
  396. 13770      IF LMGB$="2" THEN GOSUB *LCSR2DEC:LDEF=2:GOTO 13780
  397. 13775                        GOSUB *LCSRDEC :LDEF=1:GOTO 13780
  398. 13780      LMX$=LEFT$(LMG$,LCSR)+RIGHT$(LMG$,LL-LCSR-LDEF)+"  "
  399. 13785      GOSUB *LMREAD:GOSUB *LMXDSP      :GOTO *IN1C
  400. 13790 *CAN :LMX$=SPACE$(LL)                    '////////// Clear
  401. 13795      GOSUB *LMXDSP:LCSR=0:GOSUB *LCSRD
  402. 13800      GOSUB *LMREAD                    :GOTO *IN1C
  403. 13805 *LMREAD:                                 '////////// Disp Char Read 
  404. 13810      LMGFX$=MID$(LMGDX$,LCSR+1,1)
  405. 13815      IF LMGFX$="2" OR LMGF$="2" THEN MID$(LMX$,LCSR+1,1)=" "
  406. 13820 *LMREAD1:LMGD$=""
  407. 13825          FOR II=1 TO KLEN(LMX$)
  408. 13830            LMG=KTYPE(LMX$,II)
  409. 13835            IF LMG=0 THEN LMD$="0" ELSE LMD$="12"
  410. 13840            LMGD$=LMGD$+LMD$
  411. 13845          NEXT II
  412. 13850          IF LEN(LMGD$)<=LL THEN 13860
  413. 13855          LMGD$=LEFT$(LMGD$,LL):LMX$=LEFT$(LMX$,LL)
  414. 13860          IF RIGHT$(LMGD$,1)<>"1" THEN 13870
  415. 13865          MID$(LMGD$,LL,1)="0":MID$(LMX$,LL,1)=" "
  416. 13870 *LMREAD2:LMGF$=MID$(LMGD$,LCSR+1,1)
  417. 13875          IF LCSR=0 THEN LMGB$="0" ELSE LMGB$=MID$(LMGD$,LCSR,1)
  418. 13880          LMG$=LMX$:LMGDX$=LMGD$:L$(LGC)=LMG$
  419. 13885          RETURN
  420. 13890 *LCSRD :LXC=(LX+6*LCSR ):LYC=LYY:GOSUB *LCSRL: 'v2.0 :'v2.1//// Csr Disp
  421. 13895 *LCSRDX:LXC=(LX+6*LCSRX):LYC=LYY:GOSUB *LCSRL: 'v2.0 :'v2.1//// Csr Erace
  422. 13900         LCSRX=LCSR:RETURN
  423. 13905 *LCSRL :LINE(LXC,LYC+0)-(LXC+CWDT,LYC+12),XOR,LCSRCL,BF:RETURN
  424. 13910 *LCSRINC :LCSC=0:LCSR=LCSR+1:IF LCSR>=LL THEN LCSR=LL-1:LCSC=+1
  425. 13915           GOSUB *LCSRD:RETURN
  426. 13920 *LCSR2INC:LCSC=0:LCSR=LCSR+2:IF LCSR>=LL THEN LCSR=LL-2:LCSC=+1
  427. 13925           GOSUB *LCSRD:RETURN
  428. 13930 *LCSRDEC :LCSC=0:LCSR=LCSR-1:IF LCSR<0 THEN LCSR=0     :LCSC=-1
  429. 13935           GOSUB *LCSRD:RETURN
  430. 13940 *LCSR2DEC:LCSC=0:LCSR=LCSR-2:IF LCSR<0 THEN LCSR=LCSR+2:LCSC=-1
  431. 13945           GOSUB *LCSRD:RETURN
  432. 13950 *LMXDSP  :PUT@A (LX,LYY)-(LX+LL*6+1,LYY+13),LMB#    :'v2.0   :'v2.1
  433. 13955           LINE(LX,LYY+12)-(LX+(LL*6),LYY+12),XOR,LLINCL,BF   :'v2.0
  434. 13960           SYMBOL(LX,LYY),LMX$,.75!,.75!,LC
  435. 13965           GOSUB *LCSRDX:RETURN
  436. 13970 *LMBDSP  :PUT@A (LX,LYY)-(LX+LL*6+1,LYY+13),LMB#    :'v2.1
  437. 13975           SYMBOL(LX,LYY),LMX$,.75!,.75!,LB:RETURN   :'v2.1
  438. 13980 '-------------------------------------------------------------------
  439. 14000 'マウス,ウインドウ関係サブルーチン集   v1.0 1995.05.14
  440. 14010 '--------------------------------------------------
  441. 14020 '
  442. 14030 'マウスカーソル形状セット   v1.0 1994.02.13
  443. 14040 *MCDSET
  444. 14050  MOUSE 2,MCAND$(MCN),MCDOT$(MCN),MC_X(MCN),MC_Y(MCN)
  445. 14060  RETURN
  446. 14070 *MCREAD
  447. 14080  RESTORE *MCDATA
  448. 14090  FOR II=1 TO 3
  449. 14100    FOR JJ=1 TO 32:MCAND$(II)="":MCDOT$(II)="":NEXT JJ
  450. 14110    READ MC_X(II),MC_Y(II)
  451. 14120    FOR JJ=1 TO 32:READ MCAND:MCAND$(II)=MCAND$(II)+CHR$(MCAND):NEXT JJ
  452. 14130    FOR JJ=1 TO 32:READ MCDOT:MCDOT$(II)=MCDOT$(II)+CHR$(MCDOT):NEXT JJ
  453. 14140  NEXT II
  454. 14150  RETURN
  455. 14160 *MCDATA
  456. 14170 '指 ////////////////////////////////////////
  457. 14171 DATA 0,0
  458. 14172 DATA &H1F,&HFF,&H0F,&HFF,&H07,&HFF,&H83,&HFF' and
  459. 14173 DATA &HC0,&H3F,&HE0,&H07,&HF0,&H01,&HF8,&H00
  460. 14174 DATA &HF0,&H00,&HE0,&H00,&HE0,&H00,&HE0,&H00
  461. 14175 DATA &HE0,&H00,&HF0,&H00,&HF8,&H00,&HFC,&H00
  462. 14176 DATA &H00,&H00,&H60,&H00,&H30,&H00,&H18,&H00' dot
  463. 14177 DATA &H0C,&H00,&H06,&H80,&H03,&H50,&H01,&HAA
  464. 14178 DATA &H05,&HFE,&H04,&HFE,&H06,&HFE,&H07,&HFE
  465. 14179 DATA &H03,&HFF,&H01,&HFF,&H00,&H7F,&H00,&H1F
  466. 14180 'コーヒー///////////////////////////////////
  467. 14181 DATA 7,7
  468. 14182 DATA &HFF,&HFF,&HF2,&H4F,&HE4,&H9F,&HE4,&H9F' and
  469. 14183 DATA &HE6,&H1F,&HF2,&H4F,&HC0,&H07,&HC0,&H01
  470. 14184 DATA &HC0,&H06,&HC0,&H06,&HC0,&H05,&HC0,&H03
  471. 14185 DATA &HE0,&H0F,&H80,&H01,&HC0,&H03,&HE0,&H07
  472. 14186 DATA &H00,&H00,&H04,&H90,&H09,&H20,&H09,&H20' dot
  473. 14187 DATA &H08,&HA0,&H04,&H90,&H00,&H00,&H1F,&HF0
  474. 14188 DATA &H15,&HF0,&H13,&H30,&H15,&H30,&H1F,&HF0
  475. 14189 DATA &H0F,&HE0,&H00,&H00,&H1F,&HF8,&H00,&H00
  476. 14190 '待った //////////////////////////////////////
  477. 14191 DATA 7,7
  478. 14192 DATA &HF0,&H1F,&HC0,&H07,&H80,&H03,&H80,&H03' and
  479. 14193 DATA &H00,&H01,&H00,&H01,&H00,&H01,&H00,&H01
  480. 14194 DATA &H00,&H01,&H00,&H01,&H00,&H01,&H80,&H03
  481. 14195 DATA &H80,&H03,&HC0,&H07,&HF0,&H1F,&HFF,&HFF
  482. 14196 DATA &H00,&H00,&H00,&H00,&H07,&HC0,&H1F,&H80' dot
  483. 14197 DATA &H1F,&H00,&H3E,&H08,&H3C,&H18,&H38,&H38
  484. 14198 DATA &H30,&H78,&H20,&HF8,&H01,&HF0,&H03,&HF0
  485. 14199 DATA &H07,&HC0,&H00,&H00,&H00,&H00,&H00,&H00
  486. 14200 '
  487. 14210 *MCDRAG 'ドラッグ -----------------------------------------------
  488. 14220  MOUSE 1,X_M,Y_M,1                            :'現在位置にカーソルを設定
  489. 14225  MD_XB1=W_X1(G):MD_YB1=W_Y1(G) :MD_XC1=W_X1(G):MD_YC1=W_Y1(G) :'旧ｳｲﾝﾄﾞｳ座標保持
  490. 14230  MD_XB2=W_X2(G):MD_YB2=W_Y2(G) :MD_XC2=W_X2(G):MD_YC2=W_Y2(G) :'旧ｳｲﾝﾄﾞｳ座標保持
  491. 14235  GET@A(MD_XB1,MD_YB1)-(MD_XB2,MD_YB2),MD_SW#
  492. 14238  X1=X_M-W_X1(G)+W_XA(G):X2=X_M+W_XB(G)-W_X2(G):'最大移動域の設定
  493. 14239  Y1=Y_M-W_Y1(G)+W_YA(G):Y2=Y_M+W_YB(G)-W_Y2(G):'
  494. 14240  MOUSE 4,X1,Y1,X2,Y2                          :'最大移動域の設定
  495. 14245  GOSUB *MD_WLINED
  496. 14250  IF MOUSE(2,0)=-1 THEN 14245                  :'枠移動
  497. 14255   LINE(MD_XC1,MD_YC1)-(MD_XC2,MD_YC2),XOR,4,B,&HCCCC     :'枠線消去
  498. 14260  PUT@A(MD_XB1,MD_YB1)-(MD_XB2,MD_YB2),MD_SB#      :'旧ｳｲﾝﾄﾞｳ背景表示
  499. 14265  GET@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#  :'新ｳｲﾝﾄﾞｳ背景保持
  500. 14270  PUT@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SW#  :'新ｳｲﾝﾄﾞｳ描画
  501. 14275  MOUSE 4,0,0,639,479:WAIT SWAIT\4+1:RETURN
  502. 14280 *MD_WLINED
  503. 14285  MD_X_M=MOUSE(9) :MD_Y_M=MOUSE(10)                :'移動量取得
  504. 14290  W_X1(G)=W_X1(G)+(MD_X_M):W_Y1(G)=W_Y1(G)+(MD_Y_M):'新座標計算
  505. 14295  W_X2(G)=W_X2(G)+(MD_X_M):W_Y2(G)=W_Y2(G)+(MD_Y_M)
  506. 14300  LINE(MD_XC1 ,MD_YC1 )-(MD_XC2 ,MD_YC2 ),XOR,4,B,&HCCCC  :'枠線移動
  507. 14305  LINE(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),XOR,4,B,&HCCCC
  508. 14310  MD_XC1=W_X1(G):MD_YC1=W_Y1(G)
  509. 14315  MD_XC2=W_X2(G):MD_YC2=W_Y2(G)
  510. 14320  RETURN
  511. 14400 '------------------------------------------------------------------
  512. 14405 *ボタン座標読み取り
  513. 14410  RESTORE *ボタン座標:READ SWGN
  514. 14415  FOR G=1 TO SWGN
  515. 14420    READ SWN(G), W_X1(G),W_X2(G),W_Y1(G),W_Y2(G), W_XA(G),W_XB(G),W_YA(G),W_YB(G)
  516. 14425    FOR B=1 TO SWN(G):READ B_X1(G,B),B_X2(G,B),B_Y1(G,B),B_Y2(G,B):NEXT B
  517. 14430  NEXT G
  518. 14435  RETURN
  519. 14500 '-----------------------------------------------------------------
  520. 14505 *BTN_ONOFF:'ボタンON_OFF表示
  521. 14510  IF BST(G,B)=1 THEN BSC=15:BSB=1:GOTO 14520
  522. 14515                     BSC=1:BSB=15
  523. 14520   X1=W_X1(G)+B_X1(G,B):X2=W_X1(G)+B_X2(G,B)
  524. 14521   Y1=W_Y1(G)+B_Y1(G,B):Y2=W_Y1(G)+B_Y2(G,B)
  525. 14522   CONNECT(X1,Y2)-(X2,Y2)-(X2,Y1),%BSC,PSET
  526. 14523   CONNECT(X1,Y2)-(X1,Y1)-(X2,Y1),%BSB,PSET
  527. 14530  IF BSNDOFF=1 THEN 14540 :'                 WAIT SWAIT\10+1:GOTO 14540
  528. 14535  IF BST(G,B)=1 THEN SMSGPLAY 0:WAIT SWAIT\5+1
  529. 14540  BSNDOFF=0:RETURN
  530. 14600 '-----------------------------------------------------------------
  531. 14610 *MCSELECT:'マウスボタン選択
  532. 14620  SWERC=0:SWNO=0                         :'リセット
  533. 14630 *クリック待ち
  534. 14640  IF MOUSE(2,0)=-1 THEN 14680            :'左クリック入力待ち
  535. 14650  IF MOUSE(2,1)=-1 THEN SWNO=-1:RETURN   :'右クリックで終了
  536. 14660  IF MCKEY=1 THEN GOTO 14830             :'MCKEY=1: マウススキャン中断､キー入力受付
  537. 14670  GOTO *クリック待ち
  538. 14680  X_M=MOUSE(4,0):Y_M=MOUSE(5,0)          :'座標取得
  539. 14690  FOR IMS=1 TO SWN(G)                    :'ボタン座標判定
  540. 14700    IF (X_M>W_X1(G)+B_X1(G,IMS)) AND (X_M<W_X1(G)+B_X2(G,IMS)) ELSE 14730
  541. 14710    IF (Y_M>W_Y1(G)+B_Y1(G,IMS)) AND (Y_M<W_Y1(G)+B_Y2(G,IMS)) ELSE 14730
  542. 14720    SWNO=IMS:IMS=SWN(G)+1
  543. 14730  NEXT IMS
  544. 14735  WAIT SWAIT\8+1 'FOR II=1 TO 500:NEXT II
  545. 14740  IF (SWPASS=1) OR (SWNO<>0) THEN 14830
  546. 14750  IF SWNO=0 THEN
  547. 14760     GOSUB *MCMIS:SWERC=SWERC+1           '誤指定警告表示
  548. 14770     IF SWERC>5 THEN
  549. 14780       MCN=3:GOSUB *MCDSET:MESN=12:GOSUB *SNDMSG            '誤指定警告音声案内
  550. 14790       MCN=1:GOSUB *MCDSET
  551. 14800     ENDIF
  552. 14810  ENDIF
  553. 14820  GOTO *クリック待ち
  554. 14830  SWPASS=0:SW1T=0:MCKEY=0
  555. 14840  RETURN
  556. 14850 *MCMIS
  557. 14860  MCN=3:GOSUB *MCDSET:WAIT SWAIT\3+1:MCN=1:GOSUB *MCDSET
  558. 14870  RETURN
  559. 14880 '
  560. 14890 '
  561. 15000 '
  562. 15010 '  SAVE"TCLOCK.sub"             :'   組み込み型 アナログ時計 V1.1
  563. 15020 '                                       1991.05 T.KOMURA 
  564. 15030 '--------------------------------------------------------------------
  565. 15040 '
  566. 15220 *時計表示:'///////////////////////////////////
  567. 15230  XCLK0=579:YCLK0=11:CLKR=9:PI=3.1415!
  568. 15240  TIMEX$=TIME$:IF DATE$<>DATX$ THEN GOSUB *本日の日付
  569. 15250  TSC$=MID$(TIMEX$,7,2):SCR=2*PI*(VAL(TSC$)/60)
  570. 15260  TMN$=MID$(TIMEX$,4,2):MNR=2*PI*(VAL(TMN$)/60)
  571. 15270  THR$=LEFT$(TIMEX$,2) :HRR=2*PI*((VAL(THR$)*60+VAL(TMN$))/720)
  572. 15280  GOSUB *短針表示
  573. 15290  GOSUB *長針表示
  574. 15300  GOSUB *秒針表示
  575. 15305  IF DCLOCKF=1 THEN GOSUB *DCLOCKD
  576. 15310  CLOCKINIT=1:DATX$=DATE$
  577. 15320  RETURN
  578. 15330 '
  579. 15340 *短針表示
  580. 15350  XHD1=XCLK0+(CLKR*.6!)*SIN(HRR):XHD2=XCLK0
  581. 15360  YHD1=YCLK0-(CLKR*.6!)*COS(HRR):YHD2=YCLK0
  582. 15370  IF CLOCKINIT=0 THEN 15400
  583. 15380  IF SCR<>0 THEN 15420
  584. 15390  LINE(XHD1X,YHD1X)-(XHD2X,YHD2X),XOR,6
  585. 15400  LINE(XHD1 ,YHD1 )-(XHD2 ,YHD2 ),XOR,6
  586. 15410  XHD1X=XHD1:YHD1X=YHD1:XHD2X=XHD2:YHD2X=YHD2
  587. 15420  RETURN
  588. 15430 *長針表示
  589. 15440  XMD1=XCLK0+(CLKR*.8!)*SIN(MNR):XMD2=XCLK0
  590. 15450  YMD1=YCLK0-(CLKR*.8!)*COS(MNR):YMD2=YCLK0
  591. 15460  IF CLOCKINIT=0 THEN 15490
  592. 15470  IF SCR<>0 THEN 15510
  593. 15480  LINE(XMD1X,YMD1X)-(XMD2X,YMD2X),XOR,7
  594. 15490  LINE(XMD1 ,YMD1 )-(XMD2 ,YMD2 ),XOR,7
  595. 15500  XMD1X=XMD1:YMD1X=YMD1:XMD2X=XMD2:YMD2X=YMD2
  596. 15510  RETURN
  597. 15520 *秒針表示
  598. 15530  XSD1=XCLK0+(CLKR)*SIN(SCR):XSD2=XCLK0:'+(CLKR-10)*SIN(SCR)
  599. 15540  YSD1=YCLK0-(CLKR)*COS(SCR):YSD2=YCLK0:'-(CLKR-10)*COS(SCR)
  600. 15550  IF CLOCKINIT=0 THEN 15570
  601. 15560  LINE(XSD1X,YSD1X)-(XSD2X,YSD2X),XOR,4
  602. 15570  LINE(XSD1 ,YSD1 )-(XSD2 ,YSD2 ),XOR,4
  603. 15580  XSD1X=XSD1:YSD1X=YSD1:XSD2X=XSD2:YSD2X=YSD2
  604. 15590  RETURN
  605. 15600 '////////////////////////////////////////////////////////////////////
  606. 15605 ' DIGITAL CLOCK v1.0 1995.05.24 T.Komura
  607. 15610 *DCLOCKREAD:'プログラム先頭で実施
  608. 15615  RESTORE *DCLOCKDATA
  609. 15620  FOR DGII=0 TO 9:FOR DGN=1 TO 7:READ DGP(DGII,DGN):NEXT:NEXT 
  610. 15625  FOR DGII=1 TO 9:READ DGX(DGII),DGY(DGII):NEXT
  611. 15630  FOR DGII=1 TO 4:READ DGO(DGII):NEXT
  612. 15635  RETURN
  613. 15640 *DGCLOCK:'デジタル時計 -------------------------------
  614. 15645  G=4:SWNOX=SWNO:DGINIT=0:DGFC=15:DGBC=1
  615. 15650  GOSUB *DCLOCKLOAD:GOSUB *DCLOCKD:DCLOCKF=1
  616. 15655 *DGMCSEL
  617. 15660  GOSUB *MCSELECT:'マウスボタン選択
  618. 15665  IF SWNO=0 THEN *DGMCSEL
  619. 15670  IF SWNO<0 THEN SWNO=1:'右クリックで終了
  620. 15675 '             end  drag
  621. 15680  ON SWNO GOTO *DGS01,*DGS02 
  622. 15685 *DGS02:'drag
  623. 15690  DCLOCKF=0
  624. 15692  GOSUB *MCDRAG
  625. 15694  DCLOCKF=1
  626. 15695  GOTO *DGMCSEL
  627. 15700 *DGS01:'end
  628. 15705  B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  629. 15710  DCLOCKF=0
  630. 15715  GOSUB *DCLOCKCLR
  631. 15720  SWNO=SWNOX
  632. 15725  RETURN
  633. 15730 *DCLOCKLOAD
  634. 15735  GET@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  635. 15740  MOUSE 1,,,0
  636. 15745  LOAD@ TIFDRV$+"\dclock.tif",(W_X1(G),W_Y1(G)):MOUSE 1,,,1
  637. 15750  MOUSE 1,,,1:RETURN
  638. 15760 *DCLOCKCLR
  639. 15765  PUT@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  640. 15770  RETURN
  641. 15775 '
  642. 15780 *DCLOCKD
  643. 15785  IF DGINIT=1 THEN 15795
  644. 15790  FOR DGII=1 TO 4:DGM(DGII)=10:NEXT DGII:DGINIT=1
  645. 15795  DG(1)=VAL(MID$(TIME$,1,1)):DG(2)=VAL(MID$(TIME$,2,1))
  646. 15800  DG(3)=VAL(MID$(TIME$,4,1)):DG(4)=VAL(MID$(TIME$,5,1))
  647. 15805  DGPT=1-DGPT
  648. 15810  FOR DGII=1 TO 4
  649. 15815    IF DG(DGII)=DGM(DGII) THEN 15840
  650. 15820    FOR DGJJ=1 TO 7
  651. 15825      IF DGP(DG(DGII),DGJJ)=1 THEN DGC=DGFC ELSE DGC=DGBC
  652. 15826      IF DGII=1 AND DG(1)=0 THEN DGC=DGBC
  653. 15830      PAINT(W_X1(G)+DGX(DGJJ)+DGO(DGII),W_Y1(G)+DGY(DGJJ)),%DGC,0
  654. 15835    NEXT DGJJ
  655. 15840  NEXT DGII
  656. 15841      IF DGPT=1 THEN DGC=10 ELSE DGC=DGBC
  657. 15842      PAINT(W_X1(G)+DGX(8),W_Y1(G)+DGY(8)),%DGC,0
  658. 15843      PAINT(W_X1(G)+DGX(9),W_Y1(G)+DGY(9)),%DGC,0
  659. 15845  FOR DGII=1 TO 4:DGM(DGII)=DG(DGII):NEXT DGII'
  660. 15850  RETURN
  661. 15855 '
  662. 18000 '------------------------------------------------------------------
  663. 18005 *HKHELP:'             Copyrigit(C) T.Komura / HK2               /
  664. 18010 '   Version 1.0  1994.07.30                 / helpプログラム    /
  665. 18011 '   Version 2.0  1995.07.30 HK2ドラッグ対応
  666. 18015 'メインルーチン:'･･･････････････････････････････････････････････････
  667. 18016 G=3:SWNOX=SWNO:DOCDC=6:DOCBC=8
  668. 18020 GOSUB *DOCTIFDSP:GOSUB *DOCFREAD
  669. 18026 MCN=1:GOSUB *MCDSET
  670. 18030 GOSUB *DOC初期表示
  671. 18035 *DC_MSINSEL
  672. 18040 SWPASS=1:GOSUB *MCSELECT:'マウスボタン選択
  673. 18042 IF SWNO=0 THEN GOSUB *DC_他エリア判定
  674. 18043 IF SWNO<0 THEN SWNO=5:'右クリックで終了
  675. 18045 IF SWNO>7 OR SWNO=0 THEN *DC_MSINSEL
  676. 18050 IF SWNO=5 THEN GOTO *SDC_05
  677. 18055 IF SWNO=6 THEN GOTO *SDC_06
  678. 18060 IF SWNO=7 THEN GOTO *SDC_07
  679. 18065                GOTO *DOCCTRL
  680. 18070 *DOCCTRL
  681. 18075  B=SWNO:BST(G,B)=1:BSNDOFF=1:GOSUB *BTN_ONOFF
  682. 18080   DCCD=SWNO:GOSUB *DOC表示制御
  683. 18085  B=SWNO:BST(G,B)=0:GOSUB *BTN_ONOFF
  684. 18090  GOTO *DC_MSINSEL
  685. 18095 *SDC_06:       GOSUB *MCDRAG     :GOTO *DC_MSINSEL
  686. 18100 *SDC_07:DCCD=5:GOSUB *DOC表示制御:GOTO *DC_MSINSEL
  687. 18105 *SDC_05:'終了
  688. 18110  B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  689. 18115  PUT@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  690. 18120  DOCCS=0:SWNO=SWNOX
  691. 18122  RETURN:'///////////////////////////////////////////////////
  692. 18125 '
  693. 18130 'sub routine---------------------------------------------
  694. 18135 *DOCTIFDSP
  695. 18137  MOUSE 1,,,0
  696. 18140  GET@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  697. 18145  LOAD@ TIFDRV$+"\hk2help.tif",(W_X1(G),W_Y1(G))
  698. 18165  MOUSE 1,,,1:GOSUB *DOC名称表示
  699. 18170  RETURN
  700. 18175 *DOCFREAD:'helpファイル読み込み
  701. 18177  MCN=2:GOSUB *MCDSET
  702. 18180  DOCN=0:OPEN "I",#1,PRGDRV$+"\HELPF"+DOCF$
  703. 18185  IF EOF(1)=-1 THEN 18200
  704. 18190  DOCN=DOCN+1:LINE INPUT #1,DOC$(DOCN)
  705. 18195  GOTO 18185
  706. 18200  CLOSE #1:RETURN
  707. 18205 *DOC指定行表示
  708. 18210  GOSUB *DOCカーソル表示
  709. 18220  FOR DN=SDN TO EDN
  710. 18225    XDC=W_X1(G)+8:YDC=W_Y1(G)+27+DCL*12
  711. 18230    SYMBOL(XDC,YDC),DOC$(DN),.75!,.75!,7
  712. 18235    DCL=DCL+1
  713. 18240  NEXT DN:RETURN
  714. 18245 *DOC初期表示
  715. 18250  SDN=1:EDN=24:DCL=0:DSP=1:GOSUB *DOC指定行表示
  716. 18255  RETURN
  717. 18260 *DOC表示制御:'///////////////////////////////////////
  718. 18265  ON DCCD GOTO *DCC3,*DCC1,*DCC2,*DCC4,*DCC5
  719. 18270 *DCC1:'------ 前行
  720. 18275  DSP=DSP-1 :IF DSP<1 THEN DSP=1          :RETURN
  721. 18280  SDN=DSP   :GOSUB *DOC下シフト
  722. 18285  EDN=SDN   :DCL=0 :GOSUB *DOC指定行表示  :RETURN
  723. 18290 *DCC2:'------ 次行
  724. 18295  DSP=DSP+1 :IF DSP+23>DOCN THEN DSP=DSP-1:RETURN
  725. 18300  SDN=DSP+23: GOSUB *DOC上シフト
  726. 18305  EDN=SDN   :DCL=23:GOSUB *DOC指定行表示  :RETURN
  727. 18310 *DCC3:'------ 前頁
  728. 18315  DSP=DSP-24:IF DSP<1 THEN DSP=1
  729. 18320  GOTO *DCC51
  730. 18325 *DCC4:'------ 次頁
  731. 18330  DSP=DSP+24:IF DSP>DOCN THEN DSP=(DOCN\24)*24+1
  732. 18335  GOTO *DCC51
  733. 18340 *DCC5:'------ カーソル指定
  734. 18345  DSP=((INT(DOCN*DOCR))\24)*24+1
  735. 18350  IF DSP>DOCN THEN DSP=(DOCN\24)*24+1
  736. 18355 *DCC51
  737. 18360  SDN=DSP   :EDN=SDN+23
  738. 18365  IF EDN>DOCN THEN EDN=EDN-1:GOTO 18365
  739. 18370  LINE (W_X1(G)+6,W_Y1(G)+27)-(W_X1(G)+492,W_Y1(G)+27+12*24),PSET,%DOCBC,BF
  740. 18375  DCL=0:GOSUB *DOC指定行表示              :RETURN
  741. 18380 '------------------------------------------------------
  742. 18385 *DOC上シフト
  743. 18386  X1=W_X1(G)+6:Y1=W_Y1(G)+27 :X2=W_X1(G)+492:Y2=Y1
  744. 18390  GET@A(X1,Y1+12*1 )-(X2,Y2+12*24),HLPC#
  745. 18395  LINE (X1,Y1+12*23)-(X2,Y2+12*24),PSET,%DOCBC,BF
  746. 18400  PUT@A(X1,Y1      )-(X2,Y2+12*23),HLPC#
  747. 18405  RETURN
  748. 18410 *DOC下シフト
  749. 18411  X1=W_X1(G)+6:Y1=W_Y1(G)+27 :X2=W_X1(G)+492:Y2=Y1
  750. 18415  GET@A(X1,Y1     )-(X2,Y2+12*23),HLPC#
  751. 18420  LINE (X1,Y1     )-(X2,Y2+12*1 ),PSET,%DOCBC,BF
  752. 18425  PUT@A(X1,Y1+12*1)-(X2,Y2+12*24),HLPC#
  753. 18430  RETURN
  754. 18435 *DOCカーソル表示
  755. 18440  XDC1 =W_X1(G)+500:XDC2=W_X1(G)+511
  756. 18445  YDC1 =W_Y1(G)+53+INT(233*((DSP-1)  /DOCN))
  757. 18450  YDC2 =W_Y1(G)+53+INT(233*((DSP+23) /DOCN))
  758. 18451  A=W_Y1(G)+B_Y1(G,3):IF YDC2>=A  THEN YDC2=A-1
  759. 18455  YDC1X=W_Y1(G)+53+INT(233*((DSPX-1) /DOCN))
  760. 18460  YDC2X=W_Y1(G)+53+INT(233*((DSPX+23)/DOCN))
  761. 18461  A=W_Y1(G)+B_Y1(G,3):IF YDC2X>=A THEN YDC2X=A-1
  762. 18465  IF DOCCS=1 THEN 18470 ELSE DOCCS=1:GOTO 18475
  763. 18470  LINE(XDC1,YDC1X)-(XDC2,YDC2X),XOR,5,BF
  764. 18475  LINE(XDC1,YDC1 )-(XDC2,YDC2 ),XOR,5,BF
  765. 18480  DSPX=DSP :RETURN
  766. 18485 *DOC名称表示
  767. 18490  XDC=W_X1(G)+427:YDC=W_Y1(G)+7
  768. 18495  DOCD$=RIGHT$(DOCF$,LEN(DOCF$)-1)
  769. 18500  SYMBOL(XDC,YDC),DOCD$,.75!,.75!,%DOCDC
  770. 18505  RETURN
  771. 18810 *DC_他エリア判定
  772. 18830  IF (X_M>(W_X1(G)+499) AND X_M<(W_X1(G)+512)) ELSE 18845
  773. 18835  IF (Y_M>(W_Y1(G)+ 53) AND Y_M<(W_Y1(G)+288)) ELSE 18845
  774. 18840  DOCR=(Y_M-(W_Y1(G)+53))/235:SWNO=7
  775. 18845  RETURN
  776. 18850 '
  777. 19000 '
  778. 19010 '//////////////////////////////////////////////////////////////
  779. 19020 *ERROR:'      エラー処理サブルーチン V1.10   1990.11.08 T.Komura
  780. 19030 '             
  781. 19040 '
  782. 19050 IF ERR=53 THEN *IOERR
  783. 19060 IF ERR=63 THEN *FILNOF
  784. 19070 IF ERR=67 THEN *DSKFUL
  785. 19080 IF ERR=71 THEN *DSKUNF 
  786. 19090 IF ERR=72 THEN *DSKOFF
  787. 19100 IF ERR=73 THEN *DSKWP
  788. 19110 ERMES$="エラー行:"+STR$(ERL)+" エラー番号:"+STR$(ERR)+" 発生"
  789. 19120 GOSUB *ERMSG
  790. 19130 STOP
  791. 19140 '////////// エラー処理
  792. 19150 *IOERR
  793. 19160 ERMES$="ﾌﾟﾘﾝﾀｰが準備されていません｡ ﾌﾟﾘﾝﾀｰをセット後､"
  794. 19170 GOSUB *ERMSG:RESUME
  795. 19180 *DSKFUL
  796. 19190 ERMES$="ディスクが満杯です｡ 交換後､"
  797. 19200 GOSUB *ERMSG:RESUME
  798. 19210 *DSKUNF
  799. 19220 ERMES$="このディスクは使用出来ません｡処理を中断します｡ "
  800. 19230 GOSUB *ERMSG:RESUME
  801. 19240 *DSKOFF
  802. 19250 ERMES$="ディスク装置が準備されていません｡ディスクをセット後､"
  803. 19260 GOSUB *ERMSG:RESUME
  804. 19270 *DSKWP
  805. 19280 ERMES$="ディスクが書き込み禁止になっています｡解除後､"
  806. 19290 GOSUB *ERMSG:RESUME
  807. 19300 *FILNOF
  808. 19310 ERMES$="ファイルが見つかりません｡ディスクを交換後､"
  809. 19320 GOSUB *ERMSG:RESUME
  810. 19330 '
  811. 19340 *ERMSG:'////////// エラーメッセージ
  812. 19355 LINE(0,465)-(639,479),PSET,0,BF
  813. 19360 SYMBOL(0,465),ERMES$+"[実行]キーを押してね！",.75!,.75!,2
  814. 19370 COLOR 7,0:MESN=19:GOSUB *SNDMSG
  815. 19380 ERRA$=INKEY$:IF ERRA$="" THEN 19380
  816. 19390 IF ERRA$<>CHR$(&H0D) THEN 19380
  817. 19400 LINE(0,465)-(639,479),PSET,0,BF
  818. 19410 SYMBOL(0,465),"エラー処理を終わります｡",.75!,.75!,6
  819. 19420 RETURN
  820. 19430 '
  821. 19440 '
  822. 19450 '
  823. 20000 '------------------------------------------------------------------
  824. 20010 ' ＣＵＳＴＯＭ　ＳＵＢ　ＲＯＵＴＩＮＥ FOR "DOQSO.BAS"
  825. 20020 '------------------------------------------------------------------
  826. 20100 *表紙表示
  827. 20105  PLAY "L16O7C<BAG>C<BAGR2>C<BAG>C<G>L4C"
  828. 20120  LOAD@ TIFDRV$+"\hk2base.tif",(0,0)
  829. 20130  DEF FONT "システム   12ﾄﾞｯﾄ"
  830. 20140  X1A=146:Y1A=200:XPA=326:YPA=100
  831. 20142  GET@A(X1A,Y1A)-(X1A+XPA,Y1A+YPA),ABOUTD#
  832. 20144  LOAD@ TIFDRV$+"\hk2logo.tif",(X1A,Y1A)
  833. 20155 '
  834. 20160 ' INTERVAL ON
  835. 20180  RETURN
  836. 20190 '
  837. 20200 *HLIDXファイルチェック
  838. 20210  GOSUB *HKIOPN:CLOSE
  839. 20220  IF IR>0 THEN RETURN
  840. 20230  MESN=12:GOSUB *MESDSP
  841. 20240  CMES$="家計簿ファイル新規作成":GOSUB *確認
  842. 20250  ON CAUNO GOTO 20260,*S10_02
  843. 20260  GOSUB *ファイル年月入力
  844. 20300  GOSUB *新規ファイル作成
  845. 20302  IF FMAKE=0 THEN 20230
  846. 20305  MESN=4:GOSUB *MESDSP
  847. 20310  RETURN
  848. 20390 '
  849. 20400 *ファイル年月入力
  850. 20420  MESN=13:GOSUB *MESDSP:MESN=20:GOSUB *SNDMSG
  851. 20430  SYMBOL(54*8,465),"    年   月",.75!,.75!,7
  852. 20440  GOSUB *本日の日付2
  853. 20450  YR$=TY$:MN$=TM$
  854. 20470  LX=54*8-4:LY=465    :LC=5:LL=4:LG=1:LP=1
  855. 20474  L$(1)=YR$:LINS=0:GOSUB *LKEYIN
  856. 20475  YR$=L$(1):SYMBOL(LX,LY),YR$,.75!,.75!,6
  857. 20480  LX=54*8+6*6+4:LY=465:LC=5:LL=2:LG=1:LP=1
  858. 20484  L$(1)=MN$:LINS=0:GOSUB *LKEYIN
  859. 20485  MN$=L$(1):SYMBOL(LX,LY),YR$,.75!,.75!,6
  860. 20510  LINE(0,463)-(639,479),PSET,0,BF
  861. 20520  SYMBOL(0,465),YR$+"年"+MN$+"月の家計簿ファイルを作成します｡",.75!,.75!,6
  862. 20540  RETURN
  863. 20550 '
  864. 20700 *新規ファイル作成
  865. 20760  CMES$="["+YR$+"年"+MN$+"月]ファイル新規作成"
  866. 20770  GOSUB *確認
  867. 20780  ON CAUNO GOTO 20800,20875
  868. 20800  MESN=14:GOSUB *MESDSP:MESN=24:GOSUB *SNDMSG
  869. 20810  IYM$=YR$+MN$:IMAK$=SPACE$(32):'--------------IDX追加
  870. 20820  RI=IR+1:GOSUB *HKIPUT
  871. 20825  PCCD=1:PCMES$="新規家計簿ファイル作成":GOSUB *PROCD
  872. 20830  DEV$=SPACE$(128)             :'------------ファイル作成
  873. 20835  FOR JJ=1 TO 16:DYN$(JJ)=SPACE$(10):DRM$(JJ)=SPACE$(52):NEXT JJ
  874. 20840  FOR RDY=1 TO 31
  875. 20844    LINE(70*8,465)-(639,479),PSET,0,BF
  876. 20845    SYMBOL(70*8,465),RIGHT$(STR$(RDY),2)+" / 31",.75!,.75!,4
  877. 20850    GOSUB *HKDPUT
  878. 20855    PCCD=3:PCCUR=RDY:PCMAX=31:PCINT=1:GOSUB *PROCD
  879. 20860  NEXT RDY
  880. 20865  MESN=14:GOSUB *SNDMSG
  881. 20866  PCCD=2:GOSUB *PROCD
  882. 20870  FMAKE=1:RETURN
  883. 20875  FMAKE=0:RETURN
  884. 20880 '
  885. 20900 STOP
  886. 21000 *本日の日付2
  887. 21010  TY$=LEFT$(DATE$,2) :TY=VAL(TY$)
  888. 21020  IF TY<90 THEN TY=TY+2000 ELSE TY=TY+1900
  889. 21030  TY$=RIGHT$(STR$(TY),4)
  890. 21040  TM$=MID$(DATE$,4,2):TM=VAL(TM$)
  891. 21050  TD$=RIGHT$(DATE$,2):TD=VAL(TD$)
  892. 21100  RETURN
  893. 21110 '
  894. 22630 '
  895. 22900 '------------------------------------------------------------------
  896. 23500 *PROCDSP
  897. 23510  X0=178:XF=482:Y1=152:Y2=169
  898. 23520  XP=X0+INT((XF-X0)*RR/IR)
  899. 23530  LINE(X0,Y1)-(XP,Y2),PSET,1,BF
  900. 23540  RETURN
  901. 23550 '
  902. 29900 '------------------------------------------------------------------
  903. 30000 '
  904. 30100 *ABOUT表示
  905. 30105  X1A=146:Y1A=150:XPA=326:YPA=100
  906. 30106  MOUSE 1,,,0
  907. 30110  GET@A(X1A,Y1A)-(X1A+XPA,Y1A+YPA),ABOUTD#
  908. 30120  LOAD@ TIFDRV$+"\hk2logo.tif",(X1A,Y1A)
  909. 30125  MOUSE 1,,,1
  910. 30130  CMES$=ABOUT$:GOSUB *確認
  911. 30150  PUT@A(X1A,Y1A)-(X1A+XPA,Y1A+YPA),ABOUTD#
  912. 30160  RETURN
  913. 30170 '
  914. 30580 '
  915. 31000 *FADEOUT:CLS 1:CONSOLE 0,24,0
  916. 31010  FOR II=0 TO 15
  917. 31020    PALETTE II,[16*II,16*II,16*II]
  918. 31030  NEXT II
  919. 31040  FOR II=0 TO 255 STEP 5
  920. 31050    FOR JJ=0 TO 15:KK=16*JJ+II*(255-16*JJ)/255
  921. 31054      PALETTE JJ,[KK,KK,KK]
  922. 31056    NEXT JJ
  923. 31060  NEXT II
  924. 31070  RETURN
  925. 31080 '
  926. 31200 *確認
  927. 31205  G=2:SWNOX=SWNO:MOUSE 1,,,0
  928. 31210  GET@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  929. 31220  LOAD@ TIFDRV$+"\CAUTION2.TIF",(W_X1(G),W_Y1(G))
  930. 31225  PLAY "o6l4ce":MOUSE 1,,,1
  931. 31230  FOR II=1 TO 4
  932. 31232    SYMBOL(W_X1(G)+102,W_Y1(G)+9),CMES$,.75!,.75!,6
  933. 31234    WAIT SWAIT\10+1
  934. 31236    LINE(W_X1(G)+102,W_Y1(G)+9)-(W_X1(G)+102+6*39,W_Y1(G)+9+12),PSET,%9,BF
  935. 31237    WAIT SWAIT\10+1
  936. 31238  NEXT II
  937. 31239  SYMBOL(W_X1(G)+102,W_Y1(G)+9),CMES$,.75!,.75!,7
  938. 31240  MESN=19:GOSUB *SNDMSG:'28chr
  939. 31241  G=2:GOSUB *MCSELECT'ボタン選択
  940. 31242  IF SWNO<0 THEN SWNO=2
  941. 31243  IF SWNO=3 THEN GOSUB *MCDRAG:GOTO 31241
  942. 31244  IF SWNO=0 THEN 31241
  943. 31245  G=2:B=SWNO:BST(G,B)=1:GOSUB *BTN_ONOFF
  944. 31260  WAIT SWAIT\5+1
  945. 31270  PUT@A(W_X1(G),W_Y1(G))-(W_X2(G),W_Y2(G)),MD_SB#
  946. 31272  CAUNO=SWNO:SWNO=SWNOX
  947. 31275  RETURN
  948. 31280 '
  949. 32300 *PROCD:'処理状況表示
  950. 32310  ON PCCD GOTO *PC01,*PC02,*PC03
  951. 32320 *PC01
  952. 32330  GET@A(150,200)-(483,256),MD_SB#
  953. 32340  MOUSE 1,,,0:LOAD@ TIFDRV$+"\HK2PROC.TIF",(150,200):MOUSE 1,,,1
  954. 32345  SYMBOL(226,204),PCMES$,.75!,.75!,0
  955. 32350  RETURN
  956. 32360 *PC02
  957. 32370  PUT@A(150,200)-(483,256),MD_SB#
  958. 32380  RETURN
  959. 32400 *PC03:' pcmax,pccur,pcint
  960. 32410  XP0=157:YP0=240:XPM=477:YPM=250
  961. 32420  IF (PCCUR MOD PCINT)<>0 THEN RETURN
  962. 32430  XP=XP0+INT((XPM-XP0)*(PCCUR/PCMAX))
  963. 32440  LINE(XP0,YP0)-(XP,YPM),PSET,1,BF
  964. 32450  RETURN
  965. 32460 '
  966. 32880 '
  967. 35000 *HKIOPN:'---------- インデックスファイルオープン
  968. 35005  DRV$=LEFT$(DATDRV$,2)
  969. 35010  IF LEN(DATDRV$)=3 THEN DRV$=LEFT$(DATDRV$,2):PATH$="":GOTO 35020
  970. 35015  PATH$=RIGHT$(DATDRV$,LEN(DATDRV$)-2)
  971. 35020  FLN$=DRV$+"(38)"+PATH$+"\HLIDX.DAT"
  972. 35030  OPEN "R",#2,FLN$
  973. 35040  FIELD #2,6 AS I$(1),32 AS I$(2)
  974. 35050  IR=LOF(2)
  975. 35060  RETURN
  976. 35070 '
  977. 35100 *HKDOPN:'---------- 家計簿データファイルオープン
  978. 35105  DRV$=LEFT$(DATDRV$,2)
  979. 35110  IF LEN(DATDRV$)=3 THEN DRV$=LEFT$(DATDRV$,2):PATH$="":GOTO 35120
  980. 35115  PATH$=RIGHT$(DATDRV$,LEN(DATDRV$)-2)
  981. 35120  FLN$=DRV$+"(1120)"+PATH$+"\HL"+IYM$+".DAT"
  982. 35130  OPEN "R",#1,FLN$
  983. 35140  FIELD #1,128 AS D$(1),10*16 AS D$(2),52*4 AS D$(3),52*4 AS D$(4),52*4 AS D$(5),52*4 AS D$(6)
  984. 35150  AR=LOF(1)
  985. 35160  RETURN
  986. 35170 '
  987. 35270 '
  988. 36100 *HKIPUT:'---------- インデックスファイル作成
  989. 36110  GOSUB *HKIOPN
  990. 36120  LSET I$(1)=IYM$
  991. 36130  LSET I$(2)=IMK$
  992. 36140  PUT #2,RI
  993. 36150  CLOSE #2
  994. 36160  RETURN
  995. 36170 '
  996. 36300 *HKDPUT:'---------- 家計簿データ書き込み
  997. 36310  GOSUB *HKDOPN
  998. 36320  R=RDY
  999. 36330  LSET D$(1)=DEV$
  1000. 36340  DX$="":FOR II=1 TO 16:DX$=DX$+DYN$(II   ):NEXT II:LSET D$(2)=DX$
  1001. 36342  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 0):NEXT II:LSET D$(3)=DX$
  1002. 36343  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 4):NEXT II:LSET D$(4)=DX$
  1003. 36344  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+ 8):NEXT II:LSET D$(5)=DX$
  1004. 36345  DX$="":FOR II=1 TO  4:DX$=DX$+DRM$(II+12):NEXT II:LSET D$(6)=DX$
  1005. 36350  PUT #1,R
  1006. 36360  CLOSE #1
  1007. 36370  RETURN
  1008. 36380 '
  1009. 39000 '//////////////////////////////////////////////////
  1010. 39010 *CONFIGファイルチェック'  V1.4 1994.06.19
  1011. 39020 '                         FOR HK T.Komura
  1012. 39030  CFLNO=0
  1013. 39040  OPEN "R",#1,"(1)HK.CFG"
  1014. 39050  FIELD #1,1 AS D$
  1015. 39060  IF LOF(1)=0 THEN *CFGFE1
  1016. 39070  CLOSE
  1017. 39080  OPEN "I",#1,"HK.CFG"
  1018. 39085  GOSUB *CFGREAD:ABOUT$=CFG$ :'-- about$         [0]
  1019. 39090  GOSUB *CFGREAD:PRGDRV$=CFG$:'-- PRGDRV$        [1]
  1020. 39092  FILES ,C,ARY&:N=ARY&(1):DIM ARY$(N)
  1021. 39094  FILES ,N,ARY$:PRGDRV$=ARY$(0):ERASE ARY$
  1022. 39100  GOSUB *CFGREAD:DATDRV$=CFG$:'-- DATDRV$        [2]
  1023. 39110  GOSUB *CFGREAD:RAMDRV$=CFG$:'-- RAMDRV$        [3]
  1024. 39120  TIFDRV$=PRGDRV$+"\TIFF"    :'-- TIFDRV$        [4]
  1025. 39130  GOSUB *CFGREAD:FMBDRV$=CFG$:'-- FMBDRV$        [5]
  1026. 39140  GOSUB *CFGREAD             :'-- SNDMF          [6]
  1027. 39150    IF LEFT$(CFG$,5)<>"SNDMF" THEN *CFGFE2
  1028. 39160    SNDMF=VAL(RIGHT$(CFG$,1))
  1029. 39170  GOSUB *CFGREAD:SNDDRV$=CFG$:'-- SNDDRV$        [7]
  1030. 39180  GOSUB *CFGREAD             :'-- SWAIT          [8]
  1031. 39190    IF LEFT$(CFG$,4)<>"WAIT" THEN *CFGFE2
  1032. 39200    SWAIT=VAL(RIGHT$(CFG$,LEN(CFG$)-5))
  1033. 39210  FOR II=1 TO 15             :'             [9]-[10]
  1034. 39220    GOSUB *CFGREAD:CFI$(II)=CFG$
  1035. 39230  NEXT II
  1036. 39240  GOSUB *CFGREAD             :'-- DICIF         [11]
  1037. 39250    IF LEFT$(CFG$,5)<>"DICIF" THEN *CFGFE2
  1038. 39260    DICIF=VAL(RIGHT$(CFG$,1))
  1039. 39270  GOSUB *CFGREAD             :'-- DICSF         [11]
  1040. 39280    IF LEFT$(CFG$,5)<>"DICSF" THEN *CFGFE2
  1041. 39290    DICSF=VAL(RIGHT$(CFG$,1))
  1042. 39300  GOSUB *CFGREAD:DICDRV$=CFG$:'-- DICDRV$       [12]
  1043. 39310  GOSUB *CFGREAD             :'-- taxr$         [13]
  1044. 39320    IF LEFT$(CFG$,4)<>"TAXR" THEN *CFGFE2
  1045. 39330    TAXR$=RIGHT$(CFG$,LEN(CFG$)-5)
  1046. 39340  GOSUB *CFGREAD             :'-- CALCF         [14]
  1047. 39350    IF LEFT$(CFG$,5)<>"CALCF" THEN *CFGFE2
  1048. 39360    CALCF=VAL(RIGHT$(CFG$,1))
  1049. 39370  GOSUB *CFGREAD             :'--SDAY           [15]
  1050. 39380    IF LEFT$(CFG$,4)<>"SDAY" THEN *CFGFE2
  1051. 39390    SDAY=VAL(RIGHT$(CFG$,2))
  1052. 39400    SDAY$=RIGHT$(STR$(100+SDAY),2)
  1053. 39410    IF SDAY>0 THEN MOFF=0 ELSE MOFF=-1
  1054. 39420  GOSUB *CFGREAD             :'-- SSYMD$        [16]
  1055. 39430    IF LEFT$(CFG$,5)<>"SSYMD" THEN *CFGFE2
  1056. 39440    SSYMD$=RIGHT$(CFG$,8)
  1057. 39450  CLOSE
  1058. 39460  RETURN
  1059. 39470 *CFGREAD:'////////////////////////////////////
  1060. 39480  IF EOF(1)<>0 THEN *CFGFE3
  1061. 39490  LINE INPUT #1,CFG$:CFLNO=CFLNO+1
  1062. 39500  IF LEFT$(CFG$,1)="/" THEN 39480
  1063. 39510  RETURN
  1064. 39520 '------------------------------------------------------------------
  1065. 39530 *CFGFE1
  1066. 39540  CFE$="HK.CFG ファイルが見当たりません｡ 家計簿を終了します｡"
  1067. 39550  NOCFG=1:RETURN
  1068. 39560 *CFGFE2
  1069. 39570  CFE$="HK.CFGファイル 行番号"+STR$(CFLNO)+"の内容に誤りがあります｡ 家計簿を終了します｡"
  1070. 39580  GOTO *CFGFEP
  1071. 39590 *CFGFE3
  1072. 39600  CFE$="HK.CFG ファイルの項目に不足があります｡ 家計簿を終了します｡"
  1073. 39610  GOTO *CFGFEP
  1074. 39620 '-------------------------------------------------------------------
  1075. 39630 *CFGFEP
  1076. 39635  DEF FONT "システム   12ﾄﾞｯﾄ"
  1077. 39640  LINE(0,463)-(639,479),PSET,0,BF
  1078. 39645  SYMBOL(0,465),CFE$,.75!,.75!,6
  1079. 39650  CLOSE :WAIT 100
  1080. 39660  STOP
  1081. 39670 '///////////////////////////////////////////////////////////////////
  1082. 40000 *ボタン座標:'-------------------------------------------------------
  1083. 40010 DATA 4   'SWGN        スイッチグループ数 
  1084. 40020 '/////////////////////////////
  1085. 40030 '-------------------- スイッチグループ[1] メインウインドウ
  1086. 40050 DATA 10               :'ボタン個数
  1087. 40060 '    X1 ,X2 ,Y1 ,Y2
  1088. 40070 DATA 000,639,000,479  :' ウィンドウ座標   W_X1,W_X2,W_Y1,W_Y2
  1089. 40080 DATA 000,000,000,000  :'ドラッグ有効範囲 W_XA,W_XB,W_YA,W_YB
  1090. 40085 '--------------------
  1091. 40090 '    XB1 XB2 YB1 YB2
  1092. 40230 '
  1093. 40231 DATA   0,123,  0, 22  '  HK2   1
  1094. 40232 DATA 124,168,  5, 22  '記  入  2
  1095. 40233 DATA 169,212,  5, 22  '検  索  3
  1096. 40234 DATA 213,256,  5, 22  '分  析  4
  1097. 40235 DATA 257,300,  5, 22  'ｶﾚﾝﾀﾞｰ  5
  1098. 40236 DATA 301,344,  5, 22  '設  定  6
  1099. 40237 DATA 444,567,  0, 22  '日  付  7
  1100. 40238 DATA 568,591,  0, 22  'clock   8
  1101. 40240 DATA 592,615,  0, 22  'help    9
  1102. 40250 DATA 616,639,  0, 22  'END    10
  1103. 40260 '
  1104. 40430 '-------------------- スイッチグループ[2] 確認
  1105. 40432 DATA 3                :'ボタン個数
  1106. 40434 '    X1 ,X2 ,Y1 ,Y2
  1107. 40436 DATA 106,522,258,287  :' ウィンドウ座標   W_X1,W_X2,W_Y1,W_Y2
  1108. 40438 DATA 000,639,023,460  :'ドラッグ有効範囲 W_XA,W_XB,W_YA,W_YB
  1109. 40450 '--------------------
  1110. 40460 '    XB1 XB2 YB1 YB2 SWM$         SMC
  1111. 40470 DATA 338,369,  6, 23  ' OK     01
  1112. 40480 DATA 370,401,  6, 23  ' NG     02
  1113. 40485 DATA   8, 27,  5, 24  'drag
  1114. 41600 '-------------------- スイッチグループ(3) Helpグループ
  1115. 41602 DATA 6               :'ボタン個数
  1116. 41604 '    X1 ,X2 ,Y1 ,Y2
  1117. 41606 DATA  60,577,100,421  :' ウィンドウ座標   W_X1,W_X2,W_Y1,W_Y2
  1118. 41608 DATA 000,639,023,460  :'ドラッグ有効範囲 W_XA,W_XB,W_YA,W_YB
  1119. 41620 '
  1120. 41630 '    XB1 XB2 YB1 YB2 SWM$     SMC SWNO.
  1121. 41640 DATA 499,512, 25, 38  '前頁
  1122. 41650 DATA 499,512, 39, 52  '前行
  1123. 41660 DATA 499,512,289,302  '次行
  1124. 41670 DATA 499,512,303,316  '次頁
  1125. 41680 DATA 499,512,  6, 19  '終了
  1126. 41690 DATA   6, 17,  7, 18  'drag
  1127. 41830 '-------------------- スイッチグループ[4] デジタル時計
  1128. 41832 DATA 2                :'ボタン個数
  1129. 41834 '    X1 ,X2 ,Y1 ,Y2
  1130. 41836 DATA  46,607,100,306  :' ウィンドウ座標   W_X1,W_X2,W_Y1,W_Y2
  1131. 41838 DATA 000,639,023,460  :'ドラッグ有効範囲 W_XA,W_XB,W_YA,W_YB
  1132. 41850 '--------------------
  1133. 41860 '    XB1 XB2 YB1 YB2 SWM$         SMC
  1134. 41870 DATA 543,561,  0, 18  ' end    01
  1135. 41880 DATA   3, 16,  3, 16  ' drag   02
  1136. 49900 '
  1137. 50000 *DCLOCKDATA
  1138. 50010 '    1,2,3,4,5,6,7 
  1139. 50020 DATA 1,1,1,1,1,1,0 '0     (1)
  1140. 50030 DATA 0,1,1,0,0,0,0 '1     ---
  1141. 50040 DATA 1,1,0,1,1,0,1 '2    |   |(2)
  1142. 50050 DATA 1,1,1,1,0,0,1 '3 (6)|(7)|        ●(8)
  1143. 50060 DATA 0,1,1,0,0,1,1 '4     ---
  1144. 50070 DATA 1,0,1,1,0,1,1 '5    |   |(3)     ●(9)
  1145. 50080 DATA 1,0,1,1,1,1,1 '6 (5)|   |
  1146. 50090 DATA 1,1,1,0,0,0,0 '7     ---
  1147. 50100 DATA 1,1,1,1,1,1,1 '8     (4)
  1148. 50110 DATA 1,1,1,1,0,1,1 '9    
  1149. 50120 '    dgx,dgy 
  1150. 50200 DATA  80, 40       '(1)
  1151. 50210 DATA 120, 70       '(2)
  1152. 50212 DATA 110,140       '(3)
  1153. 50213 DATA  80,180       '(4)
  1154. 50214 DATA  40,140       '(5)
  1155. 50215 DATA  50, 70       '(6)
  1156. 50216 DATA  80,100       '(7)
  1157. 50217 DATA 280, 80       '(8)
  1158. 50218 DATA 280,140       '(9)
  1159. 50300 '   ofset
  1160. 50310 DATA 0      '1桁
  1161. 50320 DATA 120    '2桁
  1162. 50330 DATA 280    '3桁
  1163. 50340 DATA 400    '4桁
  1164. 50400 '
  1165. 60000 ' 座標確認 DEBUG ROUTINE
  1166. 60010 LOAD@ "e:\work\hk2\tiff\dclock.tif",(0,0)'
  1167. 60020 MOUSE 0:MOUSE 1,0,0,1
  1168. 60030  IF MOUSE(2,1)<>0 THEN STOP
  1169. 60040  IF MOUSE(2,0)=0 THEN 60040
  1170. 60050  X_M=MOUSE(4,0):Y_M=MOUSE(5,0):LX=INT(X_M/8):LY=INT(Y_M/19)
  1171. 60060  LINE(0,460)-(639,479),PSET,0,BF
  1172. 60070  SYMBOL(0,460),"X="+STR$(X_M)+" Y="+STR$(Y_M),.75!,.75!,6
  1173. 60080  GOTO 60030
  1174. 60090 ' 
  1175.